VERSION 5.00
Object = "{CDE57A40-8B86-11D0-B3C6-00A0C90AEA82}#1.0#0"; "MSDATGRD.OCX"
Begin VB.Form frmPreAssign 
   BackColor       =   &H00FFFFFF&
   Caption         =   "Pre-Assign Tracking Numbers"
   ClientHeight    =   4260
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   8475
   Icon            =   "frmPreAssign.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   ScaleHeight     =   4260
   ScaleWidth      =   8475
   StartUpPosition =   1  'CenterOwner
   Begin VB.CommandButton cmdDelete 
      Appearance      =   0  'Flat
      BackColor       =   &H00E0E0E0&
      Caption         =   "&Delete All"
      Height          =   315
      Left            =   3660
      MaskColor       =   &H0080C0FF&
      Style           =   1  'Graphical
      TabIndex        =   14
      Top             =   3780
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin MSDataGridLib.DataGrid grdPreAssign 
      Height          =   1995
      Left            =   120
      TabIndex        =   13
      TabStop         =   0   'False
      Top             =   1620
      Width           =   8235
      _ExtentX        =   14526
      _ExtentY        =   3519
      _Version        =   393216
      AllowUpdate     =   0   'False
      HeadLines       =   2
      RowHeight       =   15
      TabAction       =   2
      AllowDelete     =   -1  'True
      BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ColumnCount     =   2
      BeginProperty Column00 
         DataField       =   ""
         Caption         =   ""
         BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
            Type            =   0
            Format          =   ""
            HaveTrueFalseNull=   0
            FirstDayOfWeek  =   0
            FirstWeekOfYear =   0
            LCID            =   1033
            SubFormatType   =   0
         EndProperty
      EndProperty
      BeginProperty Column01 
         DataField       =   ""
         Caption         =   ""
         BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
            Type            =   0
            Format          =   ""
            HaveTrueFalseNull=   0
            FirstDayOfWeek  =   0
            FirstWeekOfYear =   0
            LCID            =   1033
            SubFormatType   =   0
         EndProperty
      EndProperty
      SplitCount      =   1
      BeginProperty Split0 
         BeginProperty Column00 
         EndProperty
         BeginProperty Column01 
         EndProperty
      EndProperty
   End
   Begin VB.Frame Frame2 
      BackColor       =   &H00FFFFFF&
      Caption         =   "Shipment Type"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000080FF&
      Height          =   1335
      Left            =   4320
      TabIndex        =   12
      Top             =   120
      Width           =   4035
      Begin VB.OptionButton optDomestic 
         BackColor       =   &H00FFFFFF&
         Caption         =   "Domestic Express"
         Height          =   315
         Left            =   360
         TabIndex        =   2
         Top             =   300
         Width           =   1635
      End
      Begin VB.OptionButton optIntl 
         BackColor       =   &H00FFFFFF&
         Caption         =   "Int'l Express"
         Height          =   315
         Left            =   360
         TabIndex        =   3
         Top             =   600
         Width           =   1395
      End
      Begin VB.OptionButton optCOD 
         BackColor       =   &H00FFFFFF&
         Caption         =   "COD Express"
         Height          =   315
         Left            =   360
         TabIndex        =   4
         Top             =   900
         Width           =   1455
      End
      Begin VB.OptionButton optGround 
         BackColor       =   &H00FFFFFF&
         Caption         =   "Ground/FHD"
         Height          =   315
         Left            =   2340
         TabIndex        =   6
         Top             =   600
         Width           =   1335
      End
      Begin VB.OptionButton optCanada 
         BackColor       =   &H00FFFFFF&
         Caption         =   "Intra-Canada"
         Height          =   315
         Left            =   2340
         TabIndex        =   5
         Top             =   300
         Width           =   1515
      End
   End
   Begin VB.CommandButton cmdContinue 
      Appearance      =   0  'Flat
      BackColor       =   &H00E0E0E0&
      Caption         =   "C&ontinue"
      Height          =   315
      Left            =   1860
      MaskColor       =   &H00E0E0E0&
      Style           =   1  'Graphical
      TabIndex        =   7
      Top             =   3780
      Width           =   1215
   End
   Begin VB.CommandButton cmdClose 
      Appearance      =   0  'Flat
      BackColor       =   &H00E0E0E0&
      Caption         =   "OK"
      Height          =   315
      Left            =   5460
      MaskColor       =   &H0080C0FF&
      Style           =   1  'Graphical
      TabIndex        =   8
      Top             =   3780
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.Frame Frame1 
      BackColor       =   &H00FFFFFF&
      Caption         =   " Shipment ID and Piece Count"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000080FF&
      Height          =   1335
      Left            =   120
      TabIndex        =   9
      Top             =   120
      Width           =   4035
      Begin VB.TextBox f116 
         Height          =   315
         Left            =   1500
         TabIndex        =   1
         Text            =   "1"
         Top             =   720
         Width           =   735
      End
      Begin VB.TextBox f1 
         Height          =   315
         Left            =   1500
         TabIndex        =   0
         Top             =   360
         Width           =   2355
      End
      Begin VB.Label lblNoPkgs 
         Alignment       =   1  'Right Justify
         BackColor       =   &H00FFFFFF&
         Caption         =   "# of Pkgs:"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Index           =   1
         Left            =   420
         TabIndex        =   11
         Top             =   780
         Width           =   975
      End
      Begin VB.Label lblf1 
         Alignment       =   1  'Right Justify
         BackColor       =   &H00FFFFFF&
         Caption         =   "Order ID:"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   120
         TabIndex        =   10
         Top             =   420
         Width           =   1275
      End
   End
End
Attribute VB_Name = "frmPreAssign"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False


' 2008-04-10, JFW, Allow use of PreAssign tracking number regardless of workstation.
    

Dim m_rsPreAssign As New ADODB.Recordset 'Modular level recordset
'

'---------------------------------------------------------------------------------------
' Procedure : MakePreAssign()
' DateTime  : 3/2/2005
' Purpose   : Controls the sending of trk# requests based on the number of pkgs and
'             the type of trk#s requested.
'---------------------------------------------------------------------------------------
'
Public Sub MakePreAssign(strKey As String, lngCount As Long, strType As String)
    
    Dim i As Integer
    Dim intFile As Long
    Dim rsQueryas As String
    Dim strQuery As String
    
    On Error GoTo EH
    g_strErrorLocation = "frmPreAssign:MakePreAssign"
    
    f1.Text = strKey
    f116.Text = CStr(lngCount)
    If 0 <> InStr(1, LCase(strType), "dom") Then
        optDomestic.Value = 1
    ElseIf 0 <> InStr(1, LCase(strType), "can") Then
        optCanada.Value = 1
    ElseIf 0 <> InStr(1, LCase(strType), "intl") Then
        optIntl.Value = 1
    ElseIf 0 <> InStr(1, LCase(strType), "gr") Then
        optGround.Value = 1
    End If
    
    If m_rsPreAssign Is Nothing Then
        Set m_rsPreAssign = New ADODB.Recordset
    End If
    If m_rsPreAssign.State = 0 Then
        strQuery = "SELECT * FROM PreAssign WHERE f1 = '" & f1.Text & "'"
        m_rsPreAssign.Open strQuery, g_connFSMSClient, adOpenStatic, adLockBatchOptimistic
    End If
    
    'Create a request for the number pkgs in the shipment
    For i = 1 To lngCount
        
        'Set flow control boolean to False
        g_blnComplete = False
        g_blnPreAssign = True
        
        'Domestic
        If optDomestic Then
            Call SendData(BuildTrkNumRequest(f1, "1"))
        'Intl - First is Master, subsequent are MPS
        ElseIf optIntl Then
            If f1 = "BLANK" Or (i = 1 And m_rsPreAssign.EOF) Then
                Call SendData(BuildTrkNumRequest(f1, "2"))
            Else
                Call SendData(BuildTrkNumRequest(f1, "3"))
            End If
        'COD - First is Master, subsequent are MPS
        ElseIf optCOD Then
            If i = 1 And m_rsPreAssign.EOF Then
                Call SendData(BuildTrkNumRequest(f1, "4"))
            Else
                Call SendData(BuildTrkNumRequest(f1, "5"))
            End If
        'Canada
        ElseIf optCanada Then
            Call SendData(BuildTrkNumRequest(f1, "7"))
        'Ground
        ElseIf optGround Then
            Call SendData(BuildTrkNumRequest(f1, "9"))
        Else
            Call SendData(BuildTrkNumRequest(f1, "7"))
        End If
    
        'Wait until transaction reply has been received and handled
        'before sending next request
        Do Until g_blnComplete
            DoEvents
            Call Pause(0.1)
        Loop
        DoEvents
        
    Next
    
    g_blnPreAssign = False
    
    Exit Sub
    
EH:
    MsgBox Err.Description, vbCritical, g_strErrorLocation
    
End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : cmdClose_Click()
' DateTime  : 3/2/2005
' Purpose   : Close clicked, hide form.
'---------------------------------------------------------------------------------------
'
Private Sub cmdClose_Click()
    Me.Hide
End Sub
'---------------------------------------------------------------------------------------
' Procedure : cmdContinue_Click()
' DateTime  : 3/2/2005
' Purpose   : Controls the sending of trk# requests based on the number of pkgs and
'             the type of trk#s requested.
'---------------------------------------------------------------------------------------
'
Private Sub cmdContinue_Click()
    
    On Error GoTo EH
    
    Dim i As Integer
    
    'Create a request for the number pkgs in the shipment
    For i = 1 To Val(f116)
        
        'Set flow control boolean to False
        g_blnComplete = False
        
        'Domestic
        If optDomestic Then
            Call SendData(BuildTrkNumRequest(f1, "1"))
        'Intl - First is Master, subsequent are MPS
        ElseIf optIntl Then
            If i = 1 And m_rsPreAssign.EOF Then
                Call SendData(BuildTrkNumRequest(f1, "2"))
            Else
                Call SendData(BuildTrkNumRequest(f1, "3"))
            End If
        'COD - First is Master, subsequent are MPS
        ElseIf optCOD Then
            If i = 1 And m_rsPreAssign.EOF Then
                Call SendData(BuildTrkNumRequest(f1, "4"))
            Else
                Call SendData(BuildTrkNumRequest(f1, "5"))
            End If
        'Canada
        ElseIf optCanada Then
            Call SendData(BuildTrkNumRequest(f1, "7"))
        'Ground
        ElseIf optGround Then
            Call SendData(BuildTrkNumRequest(f1, "9"))
        End If
    
        'Wait until transaction reply has been received and handled
        'before sending next request
        Do Until g_blnComplete
            DoEvents
        Loop
    
    Next
    
    Call UpdatePreAssignGrid(f1)

    Exit Sub
    
EH:
    MsgBox Err.Description, vbCritical, "frmPreAssign:cmdContinue_Click"
    
End Sub
'---------------------------------------------------------------------------------------
' Procedure : f1_LostFocus()
' DateTime  : 3/3/2005
' Purpose   : If f1 is blank disable Continue button
'---------------------------------------------------------------------------------------
'
Private Sub f1_Change()

    Call EnableContinue
    
End Sub

Private Sub f1_GotFocus()
    Call SelectAllText(f1)
End Sub

'---------------------------------------------------------------------------------------
' Procedure : f1_LostFocus()
' DateTime  : 3/2/2005
' Purpose   : Update the datagrid when OrderID loses focus.
'---------------------------------------------------------------------------------------
'
Private Sub f1_LostFocus()
    Call UpdatePreAssignGrid(f1)
End Sub

Private Sub f116_GotFocus()
    Call SelectAllText(f116)
End Sub

Private Sub Form_Activate()
    
    With frmShip
        If .f1.Visible = True Then
            f1 = .f1
            lblf1.Caption = "Order ID:"
        Else
            f1 = .cboCustID
            lblf1.Caption = "Customer ID:"
        End If
    End With
    f116 = 1
    '01/17/06 Enable/Disable available types based on country
    If g_str117 = "US" Then
        optDomestic.Enabled = True
        optCOD.Enabled = True
        optCanada.Enabled = False
        optGround.Enabled = True
    ElseIf g_str117 = "CA" Then
        optDomestic.Enabled = False
        optCOD.Enabled = False
        optCanada.Enabled = True
        optGround.Enabled = True
    ElseIf g_str117 = "MX" Then
        optDomestic.Enabled = False
        optCOD.Enabled = False
        optCanada.Enabled = False
        optGround.Enabled = True
    Else
        optDomestic.Enabled = False
        optCOD.Enabled = False
        optCanada.Enabled = False
        optGround.Enabled = False
    End If
    
    Call EnableContinue
    Call UpdatePreAssignGrid(f1)

End Sub
'---------------------------------------------------------------------------------------
' Procedure : Form_KeyDown()
' DateTime  : 3/2/2005
' Purpose   : Enter key pressed sends a TAB to move to next field
'---------------------------------------------------------------------------------------
'
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If Not TypeOf Me.ActiveControl Is CommandButton Then
        If Shift = 0 And KeyCode = 13 Then
            SendKeys "{TAB}"
        End If
    End If
End Sub
'---------------------------------------------------------------------------------------
' Procedure : grdPreAssign_BeforeDelete()
' DateTime  : 3/2/2005
' Purpose   : Verify user wishes to delete a record in the PreAssign grid.
'---------------------------------------------------------------------------------------
'
Private Sub grdPreAssign_BeforeDelete(Cancel As Integer)
    Dim intResult As Integer
    
    intResult = MsgBox("Are you sure that you want to delete selected record?", vbYesNo, "Delete Confirmation")
   
    If intResult = vbNo Then
        Cancel = True
    End If

End Sub
'---------------------------------------------------------------------------------------
' Procedure : UpdatePreAssignGrid()
' DateTime  : 3/2/2005
' Purpose   : Update the datagrid for given OrderID. Also assign column captions.
' Call from :
'---------------------------------------------------------------------------------------
'
Public Sub UpdatePreAssignGrid(ByVal strOrderID As String)
    Dim strSQL As String
    
    On Error GoTo EH
    
    'Build and open the recordset
    strSQL = "SELECT * FROM PreAssign WHERE f1 = '" & strOrderID & "'"
    ' 2008-04-10, JFW
    'strSQL = strSQL & " AND Workstation = '" & g_strComputerName & "'"
    
    If m_rsPreAssign.State = adStateOpen Then m_rsPreAssign.Close
    
    m_rsPreAssign.Open strSQL, g_connFSMSClient, adOpenStatic, adLockOptimistic

    Set grdPreAssign.DataSource = m_rsPreAssign
    With grdPreAssign
        .ClearFields
        .ReBind
        .Columns(0).Caption = "OrderID"
        .Columns(1).Caption = "COD Ret Trk #"
        .Columns(2).Caption = "Trk #"
        .Columns(3).Caption = "Type"
        .Columns(4).Visible = False
        .Columns(5).Visible = False
        .Caption = "Total Pre-Assigned Trk #s: " & Str(m_rsPreAssign.RecordCount)
        .Columns(0).Width = "1800"
        .Columns(1).Width = "1800"
        .Columns(2).Width = "1800"
        .Columns(3).Width = "1800"
    End With
    
    'Update #pkgs on Ship screen
    If m_rsPreAssign.RecordCount > 0 Then
        frmShip.f116 = Str(m_rsPreAssign.RecordCount)
        cmdDelete.Enabled = True
    Else
        cmdDelete.Enabled = False
    End If
    
    Exit Sub
    
EH:
    MsgBox Err.Description, vbCritical, "frmPreAssign:UpdatePreAssignGrid"
    
End Sub
'---------------------------------------------------------------------------------------
' Procedure : Form_Deactivate()
' DateTime  : 3/2/2005
' Purpose   : Close recordset and set to nothing when form is deactivated
'---------------------------------------------------------------------------------------
'
Private Sub Form_Deactivate()
    If m_rsPreAssign.State = adStateOpen Then m_rsPreAssign.Close
    Set m_rsPreAssign = Nothing
End Sub
'---------------------------------------------------------------------------------------
' Procedure : cmdDelete_Click()
' DateTime  : 3/3/2005
' Purpose   : Verifes user wished to delete all preassigned trk#s in a shipment
'           : and if yes, calls DeletePreAssignFromMDB and UpdatePreAssignGrid.
'---------------------------------------------------------------------------------------
'
Private Sub cmdDelete_Click()
    Dim intRet As Integer

    intRet = MsgBox("Are you sure you wish to delete all trk#s assigned to this shipment?", vbYesNo, "Confirm Delete All")
    If intRet = vbYes Then
        Call DeletePreAssignFromMDB(f1)
        Call UpdatePreAssignGrid(f1)
    End If
End Sub
'---------------------------------------------------------------------------------------
' Procedure : DeletePreAssignFromMDB()
' DateTime  : 3/3/2005
' Purpose   : Deletes all pieces in MPS for passed OrderID
'---------------------------------------------------------------------------------------
'
Public Sub DeletePreAssignFromMDB(strKey As String)
    
    Dim strSQL As String
    
    On Error GoTo EH
    
    'Build and execute the delete query
    strSQL = "DELETE FROM PreAssign WHERE f1= " & SingleQuotes(strKey)
    ' 2008-04-10, JFW
    'strSQL = strSQL & " AND Workstation = '" & g_strComputerName & "'"
    
    g_connFSMSClient.Execute strSQL
    
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, "frmPreAssign:DeletePreAssignFromMDB"

End Sub
'---------------------------------------------------------------------------------------
' Procedure : EnableContinue()
' DateTime  : 3/4/2005
' Purpose   : Enables/Disables Continue button
'---------------------------------------------------------------------------------------
'
Private Sub EnableContinue()

    If f1 = "" Then
        cmdContinue.Enabled = False
        cmdContinue.BackColor = &HE0E0E0
    Else
        cmdContinue.Enabled = True
        cmdContinue.BackColor = &HC0E0FF
    End If

End Sub
